home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Parallaxis 2.11 / fractal.p < prev    next >
Encoding:
Text File  |  1991-08-23  |  2.0 KB  |  79 lines  |  [TEXT/????]
  1. SYSTEM fractal;
  2. CONST  maxlevel = 7;
  3. (* specification of binary tree-structure *)
  4. CONFIGURATION tree [1..2**maxlevel -1];
  5. CONNECTION    son_l : tree[i] -> tree[2*i].father;
  6.               son_r : tree[i] -> tree[2*i+1].father;
  7.               father: tree[i] -> {EVEN(i)} tree[i DIV 2].son_l,
  8.                                  {ODD(i)}  tree[i DIV 2].son_r;
  9. SCALAR  i,j         : INTEGER;
  10.         delta       : REAL;
  11.         field       : ARRAY [1..2**maxlevel-1] OF REAL;
  12. VECTOR  x, low, high: REAL;
  13.  
  14. PROCEDURE Gauss(): VECTOR REAL;
  15. (* random number with Gaussian distribution *)
  16. CONST N = 4;
  17.       A = MAX(INTEGER);
  18.       GA= (3.0*FLOAT(N))**0.5;
  19.       GF= 2.0*GA / (FLOAT(N)*FLOAT(A));
  20. SCALAR i  : INTEGER; 
  21. VECTOR sum: REAL;
  22. BEGIN
  23.   sum:=0.0;
  24.   FOR i:=1 TO N DO sum:= sum + FLOAT(VIRandom()) END;
  25.   RETURN (GF*sum - GA)
  26. END Gauss;
  27.  
  28. PROCEDURE inorder(SCALAR node: INTEGER);
  29. CONST maxnode = 2 ** maxlevel -1;
  30. BEGIN
  31.   IF node <= maxnode THEN
  32.     inorder(2*node);
  33.       WriteFixPt(field[node], 10,3);
  34.       WriteLn;
  35.     inorder(2*node+1);
  36.   END
  37. END inorder;
  38.  
  39. PROCEDURE MidPointRec(SCALAR delta: REAL; SCALAR level: INTEGER);
  40. SCALAR  min, max, max2 : INTEGER;
  41. BEGIN
  42.   (* select tree-level: 2^(level-1) <= id_no <= 2^level - 1 *)
  43.   min := 2**(level-1);
  44.   max := 2 * min - 1;
  45.   max2:= 2 * max + 1;
  46.  
  47.   PARALLEL
  48.     IF min <= id_no <= max THEN
  49.       x := 0.5 * (low + high) + delta*Gauss();
  50.     END;
  51.  
  52.     (* select the current and the next tree-level for data propagation *)
  53.     IF min <= id_no <= max2 THEN
  54.       (* new values for low and high at right and left son, respectively *) 
  55.       PROPAGATE.son_l(low);
  56.       PROPAGATE.son_r(high);
  57.       PROPAGATE.son_l(x);
  58.       PROPAGATE.son_r(x);
  59.       IF EVEN(id_no) THEN high:=x ELSE low:=x END;
  60.     END
  61.   ENDPARALLEL
  62. END MidPointRec;
  63.  
  64.  
  65. BEGIN (* main *)
  66.   PARALLEL (* [1] *)   (* only the root is active *)
  67.     low  := 0.0;       (* starting value *)
  68.     high := 1.0;
  69.     x := 0.0;
  70.   ENDPARALLEL;
  71.   FOR i:=1 TO maxlevel DO
  72.     delta := 0.5 ** (FLOAT(i+1)/2.0);
  73.     MidPointRec(delta,i);
  74.   END; (* for *)
  75.   STORE(x,field);
  76.   inorder(1);
  77. END fractal.
  78.  
  79.